home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / u / utility / uhren / uhrzeit_.v11 / uhrzeit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-11-17  |  3.3 KB  |  129 lines
  1. (*$s0,d-*)
  2. program uhrzeit; (* Version 1.1 *)                   (* frei kopierbar !!!!! *)
  3.  
  4. (*****************************************************************************)
  5. (* Dieses Programm wurde entwickelt mit ST PASCAL PLUS.                      *)
  6. (* Sollte Ihnen dieses Programm gefallen, so senden Sie mir doch ein         *)
  7. (* ein kleines Anerkennungshonorar.                                          *)
  8. (* Dülmen, den 7. Februar 1987                                               *)
  9. (* Dietmar Rabich, Eschenweg 3, 4408 Dülmen                                  *)
  10. (* (PASACC.O auf 2 KByte einstellen.)                                        *)
  11. (*****************************************************************************)
  12.  
  13. const (*$igemconst.inc*)
  14.  
  15. type (*$igemtype.inc*)
  16.      ctrl_parms    = array [0..11] of integer;
  17.      int_in_vparms = array [0..15] of integer;
  18.      int_out_vparms= array [0..45] of integer;
  19.      pts_in_parms  = array [0..11] of integer;
  20.      pts_out_parms = array [0..11] of integer;
  21.  
  22. var ap_id,alert:integer;
  23.     alertstring:str255;
  24.  
  25. (*$igemsubs.inc*)
  26.  
  27. (* VDI - Aufruf *)
  28.  
  29. procedure vdi_call (cmd,sub_cmd:integer;
  30.                     nints,npts :integer;
  31.                     var ctrl   :ctrl_parms;
  32.                     var int_in :int_in_vparms;
  33.                     var int_out:int_out_vparms;
  34.                     var pts_in :pts_in_parms;
  35.                     var pts_out:pts_out_parms;
  36.                     translate  :boolean);
  37.  EXTERNAL;
  38.  
  39. (* Texthöhe *)
  40.  
  41. procedure text_height (height:integer);
  42.  
  43.  var control : ctrl_parms;
  44.      int_in  : int_in_vparms;
  45.      int_out : int_out_vparms;
  46.      pts_in  : pts_in_parms;
  47.      pts_out : pts_out_parms;
  48.  
  49.  begin
  50.   pts_in[0]:=0;
  51.   pts_in[1]:=height;
  52.   vdi_call(12,0,0,2,control,int_in,int_out,pts_in,pts_out,false);
  53.  end;
  54.  
  55. function getrez:integer;
  56. XBIOS(4);
  57.  
  58. (* Uhrzeit *)
  59.  
  60. procedure time (var str:string);
  61.  
  62.  var zeit,hou,min,pot:integer;
  63.                   h,m:string;
  64.  
  65.  function gettime:integer;
  66.  XBIOS(23);
  67.  
  68.  procedure uebersetze(n:integer; var ze:string);
  69.  
  70.   var a:integer;
  71.  
  72.   begin
  73.    a:=trunc(n/10);
  74.    ze:=concat(chr(a+48),chr(n-10*a+48));
  75.   end;
  76.  
  77.  begin
  78.   str:='';
  79.   zeit:=gettime;
  80.   hou:=shr(zeit,11);
  81.   min:=shr((zeit-shl(hou,11)),5);
  82.   uebersetze (hou,h);
  83.   uebersetze (min,m);
  84.   str:=concat(h,':',m);
  85.  end;
  86.  
  87. (* Schleife *)
  88.  
  89. procedure eloop;
  90.  
  91.  var event,dummy:integer;
  92.              msg:message_buffer;
  93.              str:string;
  94.  
  95.  begin
  96.   while true do
  97.    begin
  98.     event:=get_event(e_timer,0,0,0,100,false,0,0,0,0,false,0,0,0,0,
  99.                             msg,dummy,dummy,dummy,dummy,dummy,dummy);
  100.     time(str);
  101.     case getrez of
  102.       0 : draw_string(290,6,str);
  103.       1 : draw_string(600,6,str);
  104.       2 : draw_string(595,12,str);
  105.      end;
  106.    end;
  107.  end;
  108.  
  109. (* Hauptprogramm *)
  110.  
  111. begin
  112.  ap_id:=init_gem;
  113.  if ap_id>=0 then
  114.   begin
  115.    alertstring:=concat('[0][ UHRZEIT, Vers. 1.1,  7.2.87 |',
  116.                            ' --------------------------- |',
  117.                            ' Frei kopierbar.  Entwickelt |',
  118.                            ' mit ST PASCAL PLUS von CCD. |',
  119.                            ' Dietmar Rabich, 4408 Dülmen ][Start]');
  120.    alert:=do_alert(alertstring,1);
  121.    case getrez of
  122.      0 : text_height(4);
  123.      1 : text_height(4);
  124.      2 : text_height(6);
  125.     end;
  126.    eloop;
  127.   end;
  128. end.
  129.